BBS in a Box 15/BBS in a box XV-1.iso/Files/Tele/Pete Johnson/Mehit 3.0.b15<source>.sit/TextFiles.p

Text File | 1991-07-25 | 11.1 KB | 430 lines | [TEXT/PJMM]

unit TextFiles;

interface

uses
    Globals, HelloTabby, mehitFile, LogUtils, FileAndStuffIt;

procedure ProcessTextFiles;

implementation

const
    January = 0;
    February = 31;
    March = 59;
    April = 90;
    May = 120;
    June = 151;
    July = 181;
    August = 212;
    September = 243;
    October = 273;
    November = 304;
    December = 334;

{ ------------------------------------------------------ }

function FindDateString (lineString: str255): str255;

    var
        tempString: str255;
        slashPos, counter: integer;
        goodDate: boolean;

    begin
        goodDate := false;
        slashPos := pos('/', lineString);
        if (slashPos > 0) & (slashPos > 2) & (length(lineString) > (slashPos + 5)) then
            begin
                goodDate := true;
                tempString := copy(lineString, slashPos - 2, 8);
                for counter := 1 to length(tempString) do
                    if not (tempString[counter] in ['0'..'9', '/']) then
                        goodDate := false
            end;
        if goodDate then
            FindDateString := tempString
        else
            FindDateString := ''
    end;

{ ------------------------------------------------------ }

function FindDayOfYear (Now: DateTimeRec): integer;

    var
        WhatDay: integer;

    begin
        with Now do
            begin
                case Month of
                    1:
                        whatDay := January + Day;
                    2:
                        whatDay := February + Day;
                    3:
                        whatDay := March + Day;
                    4:
                        whatDay := April + Day;
                    5:
                        whatDay := May + Day;
                    6:
                        whatDay := June + Day;
                    7:
                        whatDay := July + Day;
                    8:
                        whatDay := August + Day;
                    9:
                        whatDay := September + Day;
                    10:
                        whatDay := October + Day;
                    11:
                        whatDay := November + Day;
                    12:
                        whatDay := December + Day;
                end;        {case}
                if Year mod 4 = 0 then
                    if (Month > 2) | ((Month = 2) & (Day > 28)) then
                        whatDay := succ(whatDay);
            end;
        FindDayOfYear := whatDay;
    end;

{ ------------------------------------------------------ }

procedure DecrementDay (var DayOfYear, Year: integer);

    begin
        if dayOfYear > 1 then
            dayOfYear := pred(dayOfYear)
        else
            begin
                Year := pred(Year);
                if Year mod 4 = 0 then
                    dayOfYear := 366
                else
                    dayOfYear := 365
            end
    end;

{ ------------------------------------------------------ }

function TwoDigits (ANumber: integer): str255;

    var
        aString: str255;

    begin
        aString := stringOf(ANumber : 1);
        if length(aString) < 2 then
            aString := concat('0', aString);
        TwoDigits := aString
    end;

{ ------------------------------------------------------ }

function MakeDateString (Month, Day, Year: integer): str255;

    begin
        MakeDateString := concat(TwoDigits(Month), '/', TwoDigits(Day), '/', TwoDigits(Year - 1900))
    end;

{ ------------------------------------------------------ }

function DaysAgoString (DaysAgo: integer): str255;

    var
        Now: dateTimeRec;
        dayOfYear, counter: integer;
        tempLong: longint;

    begin
        GetTime(Now);
        dayOfYear := FindDayOfYear(Now);
        for counter := 1 to DaysAgo do
            DecrementDay(dayOfYear, Now.Year);
        Now.Month := 1;
        Now.Day := DayOfYear;
        Date2Secs(Now, tempLong);
        Secs2Date(tempLong, Now);
        DaysAgoString := MakeDateString(Now.Month, Now.Day, Now.Year)
    end;

{ ------------------------------------------------------ }

function IsLess (string1, string2: str255): boolean;    {compares two mm/dd/yy date strings}

    var
        tempString: str255;

    begin
        while pos('/', string1) > 0 do
            delete(string1, pos('/', string1), 1);                {mmddyy}
        tempString := copy(string1, (length(string1) - 1), 2);    {copy year}
        string1 := copy(string1, 1, length(string1) - 2);        {lop off year}
        string1 := concat(tempstring, string1);                {begin with year: yymmdd}

        while pos('/', string2) > 0 do
            delete(string2, pos('/', string2), 1);                {mmddyy}
        tempString := copy(string2, (length(string2) - 1), 2);    {copy year}
        string2 := copy(string2, 1, length(string2) - 2);        {lop off year}
        string2 := concat(tempstring, string2);                {begin with year: yymmdd}
        if string1 < string2 then
            IsLess := true
        else
            IsLess := false
    end;

{ ------------------------------------------------------ }

procedure DoMonthlyArc (LogPath, Nickname: str255; when: integer; StuffMode: StuffOpts);

    var
        MonthlyName, tempName: str255;
        ThisMonth, ThisYear, namePos: integer;
        Today: DateTimeRec;

    begin
        GetTime(Today);
        if Today.Day = when then
            begin
                if MultiFinder then
                    IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                if Today.Month = 1 then
                    begin
                        ThisMonth := 12;
                        ThisYear := pred(Today.Year)
                    end
                else
                    begin
                        ThisMonth := pred(Today.Month);
                        ThisYear := Today.Year;
                    end;

                tempName := concat(GetPath(LogPath), Nickname);
                MonthlyName := concat(tempName, ' ', TwoDigits(ThisMonth), '/', TwoDigits(ThisYear mod 100));
                Err := Rename(LogPath, DefaultVol, MonthlyName);
                Err := Create(LogPath, DefaultVol, DefaultsPtr^.TEXTType, 'TEXT');
                if (StuffMode in [DoNone..DoBetter]) then
                    StuffOne(MonthlyName, StuffMode, true);
                UnloadSeg(@StuffOne)
            end        {if Today.Day = when}
    end;

{ ------------------------------------------------------ }

procedure ResetLog (LogPath, Nickname: STR255; LogDays, ArcDays: integer; Daily: boolean; StuffMode: StuffOpts);

{    If Daily is false, then do monthly archive.                }

    const
        BUFSIZE = 16384;

    var
        TheLogArchive, LogString, TheTempFile, LogDateString, ArcDateString, tempString: STR255;
        lineDateString: str255;
        LogRef, LogArcRef, TempRef: integer;
        fndrInfo: FInfo;
        Quit: boolean;
        LogPos, logicalEOF, gulp: longint;
        bufPtr: ptr;

    begin
        bufPtr := newPtr(BUFSIZE);
        LogDateString := DaysAgoString(LogDays - 1);                { string of earliest valid date }
        ArcDateString := DaysAgoString(ArcDays + LogDays - 1);        { string of earliest valid date }

        if MultiFinder then
            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);

        Err := FSOpen(LogPath, DefaultVol, LogRef);
        if err = NoErr then
            Err := GetEOF(LogRef, logicalEOF);
        if (logicalEOF > 0) & (err = NoErr) then
            begin
                TheLogArchive := concat(LogPath, '.Arch');
                Err := GetFInfo(TheLogArchive, DefaultVol, fndrInfo);
                if Err = noErr then
                    begin
                        with fndrInfo do
                            begin
                                fndrInfo.fdType := 'TEXT';
                                fndrInfo.fdCreator := DefaultsPtr^.TextType
                            end;
                        Err := SetFInfo(TheLogArchive, DefaultVol, fndrInfo);
                    end
                else
                    Err := Create(TheLogArchive, DefaultVol, DefaultsPtr^.TEXTType, 'TEXT');
                Err := FSOpen(TheLogArchive, DefaultVol, LogArcRef);
                Err := SetFPos(LogArcRef, fsFromLEOF, 0);

                Quit := false;

                while (not AtEOF(LogRef)) & (not Quit) & (Err = NoErr) do
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        Err := ReadALine(LogRef, LogString);
                        lineDateString := FindDateString(LogString);
                        if (Err = NoErr) then
                            if (lineDateString = '') | (IsLess(lineDateString, LogDateString)) then
                                Err := WrLn(LogArcRef, LogString)
                            else
                                Quit := true;
                    end;

                Err := FSClose(LogArcRef);
                TheTempFile := concat(LogPath, '.$$$');
                Err := FSDelete(TheTempFile, DefaultVol);
                Err := Create(TheTempFile, DefaultVol, DefaultsPtr^.TEXTType, 'TEXT');
                Err := FSOpen(TheTempFile, DefaultVol, TempRef);

                if pos(LogDateString, LogString) > 0 then
                    Err := WrLn(TempRef, LogString);

                gulp := BUFSIZE;
                while (Err = NoErr) & (not AtEOF(LogRef)) & (gulp = BUFSIZE) do
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        Err := FSRead(LogRef, gulp, bufPtr);
                        Err := FSWrite(TempRef, gulp, bufPtr)
                    end;

                Err := FSClose(TempRef);
                Err := FSClose(LogRef);
                Err := FSDelete(LogPath, DefaultVol);
                Err := Rename(TheTempFile, DefaultVol, LogPath);

    {trim archives if necessary}

                if Daily then
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        TheTempFile := concat(TheLogArchive, '.$$$');
                        Err := FSDelete(TheTempFile, DefaultVol);
                        Err := Create(TheTempFile, DefaultVol, DefaultsPtr^.TEXTType, 'TEXT');
                        Err := FSOpen(TheTempFile, DefaultVol, TempRef);

                        Err := FSOpen(TheLogArchive, DefaultVol, LogArcRef);

                        repeat
                            if MultiFinder then
                                IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                            Err := ReadALine(LogArcRef, LogString);
                        until (Err <> NoErr) | (not (IsLess(FindDateString(LogString), ArcDateString))) | (AtEOF(LogArcRef));
                        if Err = NoErr then
                            Err := WrLn(TempRef, LogString);

                        gulp := BUFSIZE;
                        while (Err = NoErr) & (gulp = BUFSIZE) & (not AtEOF(LogArcRef)) do
                            begin
                                if MultiFinder then
                                    IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                                Err := FSRead(LogArcRef, gulp, bufPtr);
                                Err := FSWrite(TempRef, gulp, bufPtr)
                            end;

                        Err := FSClose(TempRef);
                        Err := FSClose(LogArcRef);
                        Err := FSDelete(TheLogArchive, DefaultVol);
                        Err := Rename(TheTempFile, DefaultVol, TheLogArchive)
                    end        {if Daily}
                else
                    DoMonthlyArc(TheLogArchive, Nickname, LogDays, StuffMode);

                if bufPtr <> nil then
                    begin
                        DisposPtr(bufPtr);
                        bufPtr := nil
                    end
            end {if (logicalEOF > 0) & (Err = NoErr)}
        else
            Err := FSClose(LogRef)
    end;

{ ------------------------------------------------------ }

procedure ProcessCL;

    var
        CLDays, CLADays: integer;
        DoCLADays: boolean;
        DoCLAStuff: StuffOpts;

    begin
        CLDays := DefaultsPtr^.CLDays;
        CLADays := DefaultsPtr^.CLADays;
        DoCLADays := DefaultsPtr^.DoCLADays;
        DoCLAStuff := DefaultsPtr^.DoCLAStuff;
        ResetLog(CLPath, 'CL', CLDays, CLADays, DoCLADays, DoCLAStuff)
    end;

{ ------------------------------------------------------ }

procedure ProcessTL;

    var
        TLDays, TLADays: integer;
        DoTLADays: boolean;
        DoTLAStuff: StuffOpts;

    begin
        TLDays := DefaultsPtr^.TLDays;
        TLADays := DefaultsPtr^.TLADays;
        DoTLADays := DefaultsPtr^.DoTLADays;
        DoTLAStuff := DefaultsPtr^.DoTLAStuff;
        ResetLog(concat(gDefaultPath, 'Tabby:Tabby Log'), 'TL', TLDays, TLADays, DoTLADays, DoTLAStuff)
    end;

{ ------------------------------------------------------ }

procedure ProcessTextFiles;

    var
        tempString: str255;
        oldGrafPort: grafptr;

    begin
        TextFont(0);
        TextSize(12);
        ForeColor(BlueColor);
        tempString := 'mehitabel: doing logs…';
        EraseRect(StatusRect);
        TextBox(Pointer(ord(@TempString) + 1), length(TempString), StatusRect, teJustLeft);
        with DefaultsPtr^ do
            begin
                if ResetCL then
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        tempString := 'callerlog';
                        EraseRect(MsgNoRect);
                        TextFont(Geneva);
                        TextSize(9);
                        ForeColor(RedColor);
                        TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
                        ProcessCL
                    end;
                if ResetTL then
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        tempString := 'tabby log';
                        EraseRect(MsgNoRect);
                        TextFont(Geneva);
                        TextSize(9);
                        ForeColor(RedColor);
                        TextBox(Pointer(ord(@TempString) + 1), length(TempString), MsgNoRect, teJustRight);
                        ProcessTL
                    end
            end;
        setport(oldGrafPort);
    end;

{ ------------------------------------------------------ }

end.